perm filename QUEENS.FAI[1,BGB]1 blob
sn#015520 filedate 1972-12-06 generic text, type T, neo UTF8
00100 TITLE QUEENS PUZZLE PROBLEM - 1 DECEMBER 1972.
00200
00300 ;ACCUMULATORS
00400
00500 Q1←7
00600 Q2←10
00700 R←11 ↔ ROW←12
00800 C←13 ↔ COL←14
00900 K←14
01000 CNT←15
01100 I←16
01200 J←17
01300
01400 ; ALTERNATE PDP-10 MNEMONICS.
01500
01600 OPDEF LIP[HLR]↔OPDEF LAP[HRR]↔OPDEF DIP[HRLM]
01700 OPDEF DAP[HRRM]↔OPDEF CAR[HLRZ]↔OPDEF CDR[HRRZ]
01800 OPDEF DIPZ[HRLZM]↔OPDEF DAPZ[HRRZM]↔OPDEF ZIP[HRRZS]
01900 OPDEF ZAP[HLLZS]↔OPDEF WIP[HRROS]↔OPDEF WAP[HRRZS]
02000 OPDEF NIP[HLRE]↔OPDEF NAP[HRRE]↔OPDEF NIM[HRREI]
02100 OPDEF LAC[MOVE]↔OPDEF DAC[MOVEM]↔OPDEF SLAC[MOVS]
02200 OPDEF GO[JRST]↔OPDEF LACI[MOVEI]↔OPDEF SLACI[MOVSI]
02300 OPDEF LAPI[HRRI]↔OPDEF LIPI[HRLI]↔OPDEF LACN[MOVN]
02400
02500 ;YE VERY OLDE TYPE OUT DECIMAL NUMBER ROUTINE.
02600
02700 ONUM: IDIVI 1,12↔PUSH 17,2↔SKIPE 1↔PUSHJ 17,ONUM
02800 POP 17,1↔ADDI 1,60↔OUTCHR 1↔POPJ 17,
02900
03000 PDL: BLOCK 100
00100 ;TABLES OF THE GROUP OF SYMMETRIES OF A SQUARE.
00200
00300
00400 ;T0:
00500 ;00 ;01 ;02 ;03 ;04 ;05 ;06 ;07
00600 ;10 ;11 ;12 ;13 ;14 ;15 ;16 ;17
00700 ;20 ;21 ;22 ;23 ;24 ;25 ;26 ;27
00800 ;30 ;31 ;32 ;33 ;34 ;35 ;36 ;37
00900 ;40 ;41 ;42 ;43 ;44 ;45 ;46 ;47
01000 ;50 ;51 ;52 ;53 ;54 ;55 ;56 ;57
01100 ;60 ;61 ;62 ;63 ;64 ;65 ;66 ;67
01200 ;70 ;71 ;72 ;73 ;74 ;75 ;76 ;77
01300
01400 T1:
01500 07 ↔06 ↔05 ↔04 ↔03 ↔02 ↔01 ↔00
01600 17 ↔16 ↔15 ↔14 ↔13 ↔12 ↔11 ↔10
01700 27 ↔26 ↔25 ↔24 ↔23 ↔22 ↔21 ↔20
01800 37 ↔36 ↔35 ↔34 ↔33 ↔32 ↔31 ↔30
01900 47 ↔46 ↔45 ↔44 ↔43 ↔42 ↔41 ↔40
02000 57 ↔56 ↔55 ↔54 ↔53 ↔52 ↔51 ↔50
02100 67 ↔66 ↔65 ↔64 ↔63 ↔62 ↔61 ↔60
02200 77 ↔76 ↔75 ↔74 ↔73 ↔72 ↔71 ↔70
02300
02400 T2:
02500 70 ↔71 ↔72 ↔73 ↔74 ↔75 ↔76 ↔77
02600 60 ↔61 ↔62 ↔63 ↔64 ↔65 ↔66 ↔67
02700 50 ↔51 ↔52 ↔53 ↔54 ↔55 ↔56 ↔57
02800 40 ↔41 ↔42 ↔43 ↔44 ↔45 ↔46 ↔47
02900 30 ↔31 ↔32 ↔33 ↔34 ↔35 ↔36 ↔37
03000 20 ↔21 ↔22 ↔23 ↔24 ↔25 ↔26 ↔27
03100 10 ↔11 ↔12 ↔13 ↔14 ↔15 ↔16 ↔17
03200 00 ↔01 ↔02 ↔03 ↔04 ↔05 ↔06 ↔07
03300
03400 T3:
03500 77 ↔76 ↔75 ↔74 ↔73 ↔72 ↔71 ↔70
03600 67 ↔66 ↔65 ↔64 ↔63 ↔62 ↔61 ↔60
03700 57 ↔56 ↔55 ↔54 ↔53 ↔52 ↔51 ↔50
03800 47 ↔46 ↔45 ↔44 ↔43 ↔42 ↔41 ↔40
03900 37 ↔36 ↔35 ↔34 ↔33 ↔32 ↔31 ↔30
04000 27 ↔26 ↔25 ↔24 ↔23 ↔22 ↔21 ↔20
04100 17 ↔16 ↔15 ↔14 ↔13 ↔12 ↔11 ↔10
04200 07 ↔06 ↔05 ↔04 ↔03 ↔02 ↔01 ↔00
04300
00100 T4:
00200 70 ↔60 ↔50 ↔40 ↔30 ↔20 ↔10 ↔00
00300 71 ↔61 ↔51 ↔41 ↔31 ↔21 ↔11 ↔01
00400 72 ↔62 ↔52 ↔42 ↔32 ↔22 ↔12 ↔02
00500 73 ↔63 ↔53 ↔43 ↔33 ↔23 ↔13 ↔03
00600 74 ↔64 ↔54 ↔44 ↔34 ↔24 ↔14 ↔04
00700 75 ↔65 ↔55 ↔45 ↔35 ↔25 ↔15 ↔05
00800 76 ↔66 ↔56 ↔46 ↔36 ↔26 ↔16 ↔06
00900 77 ↔67 ↔57 ↔47 ↔37 ↔27 ↔17 ↔07
01000
01100 T5:
01200 77 ↔67 ↔57 ↔47 ↔37 ↔27 ↔17 ↔07
01300 76 ↔66 ↔56 ↔46 ↔36 ↔26 ↔16 ↔06
01400 75 ↔65 ↔55 ↔45 ↔35 ↔25 ↔15 ↔05
01500 74 ↔64 ↔54 ↔44 ↔34 ↔24 ↔14 ↔04
01600 73 ↔63 ↔53 ↔43 ↔33 ↔23 ↔13 ↔03
01700 72 ↔62 ↔52 ↔42 ↔32 ↔22 ↔12 ↔02
01800 71 ↔61 ↔51 ↔41 ↔31 ↔21 ↔11 ↔01
01900 70 ↔60 ↔50 ↔40 ↔30 ↔20 ↔10 ↔00
02000
02100 T6:
02200 00 ↔10 ↔20 ↔30 ↔40 ↔50 ↔60 ↔70
02300 01 ↔11 ↔21 ↔31 ↔41 ↔51 ↔61 ↔71
02400 02 ↔12 ↔22 ↔32 ↔42 ↔52 ↔62 ↔72
02500 03 ↔13 ↔23 ↔33 ↔43 ↔53 ↔63 ↔73
02600 04 ↔14 ↔24 ↔34 ↔44 ↔54 ↔64 ↔74
02700 05 ↔15 ↔25 ↔35 ↔45 ↔55 ↔65 ↔75
02800 06 ↔16 ↔26 ↔36 ↔46 ↔56 ↔66 ↔76
02900 07 ↔17 ↔27 ↔37 ↔47 ↔57 ↔67 ↔77
03000
03100 T7:
03200 07 ↔17 ↔27 ↔37 ↔47 ↔57 ↔67 ↔77
03300 06 ↔16 ↔26 ↔36 ↔46 ↔56 ↔66 ↔76
03400 05 ↔15 ↔25 ↔35 ↔45 ↔55 ↔65 ↔75
03500 04 ↔14 ↔24 ↔34 ↔44 ↔54 ↔64 ↔74
03600 03 ↔13 ↔23 ↔33 ↔43 ↔53 ↔63 ↔73
03700 02 ↔12 ↔22 ↔32 ↔42 ↔52 ↔62 ↔72
03800 01 ↔11 ↔21 ↔31 ↔41 ↔51 ↔61 ↔71
03900 00 ↔10 ↔20 ↔30 ↔40 ↔50 ↔60 ↔70
00100 ;One Queen Attack Table - 64 boards.
00200 QAT1: BLOCK =64
00300 QAT2: BLOCK =64
00400
00500 ;Two Queens Attack Table - 2016 boards.
00600 QQAT1: BLOCK =2016
00700 QQAT2: BLOCK =2016
00800 QQL1: BLOCK =2016
00900 QQL2: BLOCK =2016
01000
01100 ;Scratch Attack Table - 2016 boards.
01200 SAT1: BLOCK =2016
01300 SAT2: BLOCK =2016
01400 SAT3: 0
01500
01600 ;Column attack table - 8 boards.
01700 CAT: 1001001001B28↔1001001001B28 ;COL 0.
01800 1001001001B29↔1001001001B29 ;COL 1.
01900 1001001001B30↔1001001001B30 ;COL 2.
02000 1001001001B31↔1001001001B31 ;COL 3.
02100 1001001001B32↔1001001001B32 ;COL 4.
02200 1001001001B33↔1001001001B33 ;COL 5.
02300 1001001001B34↔1001001001B34 ;COL 6.
02400 1001001001B35↔1001001001B35 ;COL 7.
02500
02600 ;Row Attack Table - 8 boards.
02700 RAT: 377B8↔0 ;ROW 0.
02800 377B17↔0 ;ROW 1.
02900 377B26↔0 ;ROW 2.
03000 377B35↔0 ;ROW 3.
03100 0↔377B8 ;ROW 4.
03200 0↔377B17 ;ROW 5.
03300 0↔377B26 ;ROW 6.
03400 0↔377B35 ;ROW 7.
03500
03600 ;Byte pointer to column 7 of each row.
03700 ROWPTR: POINT 1,Q1,8 ↔ POINT 1,Q1,17 ;ROWS 0 & 1.
03800 POINT 1,Q1,26↔ POINT 1,Q1,35 ;ROWS 2 & 3.
03900 POINT 1,Q2,8 ↔ POINT 1,Q2,17 ;ROWS 4 & 5.
04000 POINT 1,Q2,26↔ POINT 1,Q2,35 ;ROWS 6 & 7.
04100
04200 ;Byte pointer P-bits of each column.
04300 COLPTR: 7B5↔6B5↔5B5↔4B5
04400 3B5↔2B5↔1B5↔0
04500
04600 ;Make a bit pointer to a square of the board.
04700 DEFINE MKPTR{LAC 1,ROWPTR(R)↔ADD 1,COLPTR(C)}
00100 ;MAKE ONE QUEEN ATTACK TABLE.
00200 MKQAT: 0
00300 LACI I,100↔LACI ROW,7↔LACI COL,7↔SOS I
00400 LSH ROW,1↔LAC Q1,RAT(ROW)↔LAC Q2,RAT+1(ROW)↔LSH ROW,-1
00500 LSH COL,1↔IOR Q1,CAT(COL)↔IOR Q2,CAT+1(COL)↔LSH COL,-1
00600 LACI 1
00700 LAC R,ROW↔LAC C,COL↔JSR NE
00800 LAC R,ROW↔LAC C,COL↔JSR NW
00900 LAC R,ROW↔LAC C,COL↔JSR SW
01000 LAC R,ROW↔LAC C,COL↔JSR SE
01100 LAC R,ROW↔LAC C,COL↔MKPTR↔SETZ↔DPB 0,1
01200 DAC Q1,QAT1(I)↔DAC Q2,QAT2(I)
01300 SOJGE COL,MKQAT+4
01400 SOJGE ROW,MKQAT+3
01500 GO @MKQAT
01600
01700 ;NORTH EAST ATTACK: R-1,C+1.
01800 NE: 0
01900 SOSGE R↔GO@NE
02000 AOS C↔CAIN C,8↔GO @NE
02100 MKPTR↔DPB 0,1↔GO NE+1
02200
02300 ;NORTH WEST ATTACK: R-1,C-1.
02400 NW: 0
02500 SOSGE R↔GO@NW
02600 SOSGE C↔GO@NW
02700 MKPTR↔DPB 0,1↔GO NW+1
02800
02900 ;SOUTH WEST ATTACK: R+1,C-1.
03000 SW: 0
03100 AOS R↔CAIN R,8↔GO@SW
03200 SOSGE C↔GO@SW
03300 MKPTR↔DPB 0,1↔GO SW+1
03400
03500 ;SOUTH EAST ATTACK: R+1,C+1.
03600 SE: 0
03700 AOS R↔CAIN R,8↔GO@SE
03800 AOS C↔CAIN C,8↔GO@SE
03900 MKPTR↔DPB 0,1↔GO SE+1
04000
00100 ;MAKE TWO QUEEN ATTACK TABLE - UNORDERED PAIR OF QUEENS.
00200 MKQQAT: 0
00300 SETZ I,
00400 SETZ 1,
00500 L1: SETZ 2,
00600 L2: CAML 1,2↔GO L3
00700 LAC QAT1(1)↔IOR QAT1(2)↔DAC QQAT1(I)
00800 LAC QAT2(1)↔IOR QAT2(2)↔DAC QQAT2(I)
00900 DAC 1,QQL1(I)
01000 DAC 2,QQL2(I)
01100 AOS I
01200 L3: AOS 2↔CAIE 2,100↔GO L2
01300 AOS 1↔CAIE 1,100↔GO L1
01400 GO @MKQQAT
01500
01600 ;MAKE A PARTIAL THREE QUEEN ATTACK TABLE.
01700 ;ARGUMENT - THIRD QUEEN'S POSITION NUMBER - AC1.
01800 MK3QAT:0
01900 LAC[XWD QQAT1,SAT1]↔BLT SAT3-1
02000 LAC Q1,QAT1(K)
02100 LAC Q2,QAT2(K)
02200 IOR Q1,[400400400400] ;SET EMPTY BITS.
02300 IOR Q2,[400400400400]
02400 LACI I,=2016
02500 IORM Q1,SAT1(I)
02600 IORM Q2,SAT2(I)
02700 SOJGE I,.-2
02800 GO @MK3QAT
00100 ;MAKE FIVE QUEEN ATTACKS - RECORD FULL BOARD COVERAGE.
00200 MK5QAT: 0
00300 SETZ CNT,
00400 SETZ I,
00500 M1: SETZ J,
00600 CAML K,QQL1(I)↔GO M4
00700 LAC 0,QQL2(I)
00800 M2: CAML 0,QQL1(J)↔GO M3
00900 SETCM Q1,SAT1(I)↔ANDCM Q1,SAT1(J)↔JUMPN Q1,M3
01000 SETCM Q2,SAT2(I)↔ANDCM Q2,SAT2(J)↔JUMPN Q2,M3
01100
01200 ;DETECT SOLUTIONS THAT ARE REDUNDANT BECAUSE THEY CAN BE
01300 ;MAPPED INTO A FORM WITH A QUEEN LESS THAN K.
01400 LAC 1,K↔LSH 1,6
01500 IOR 1,QQL1(I)↔JSR SYMM↔LSH 1,6
01600 IOR 1,QQL2(I)↔JSR SYMM↔LSH 1,6
01700 IOR 1,QQL1(J)↔JSR SYMM↔LSH 1,6
01800 IOR 1,QQL2(J)↔JSR SYMM
01900
02000 ;DETECT SOLUTIONS THAT ARE REDUNDANT BECAUSE THEY MAP
02100 ;A QUEEN INTO POSITION K AND HAVE ALREADY BEEN RECORDED.
02200 JUMPE CNT,M5↔DAC 1,10
02300 JSR SYMM2↔ROT 1,-6
02400 JSR SYMM2↔ROT 1,-6
02500 JSR SYMM2↔ROT 1,-6
02600 JSR SYMM2↔LSH 1,-6
02700 JSR SYMM2↔LAC 1,10
02800
02900 ;OUTPUT A SOLUTION TO THE BUFFER.
03000 M5: AOS 2,SUBTOTAL#
03100 AOS CNT
03200 M0: DAC 1,BUFFER(2)
03300
03400 M3: AOS J↔CAIE J,=2016↔GO M2
03500 M4: AOS I↔CAIE I,=2016↔GO M1
03600 GO @MK5QAT
03700
03800 BUFFER: BLOCK 5000
00100 ;IGNORE REDUNDANT SOLUTIONS DUE TO BOARD SYMMETRIES.
00200 ; π/2 ROTATIONS; DIAGONAL, HORIZONTAL & VERTICAL REFLECTIONS.
00300 SYMM: 0
00400 LAC 2,1
00500 ANDI 2,77
00600 FOR @' I←1,7{
00700 CAMLE K,T'I(2)↔GO M3}
00800 GO@SYMM
00900 SYMM2: 0
01000 LAC 2,1
01100 ANDI 2,77
01200 FOR @' I←1,7{
01300 CAMN K,T'I(2)↔JSP 12,SYMT'I}
01400 GO @SYMM2
01500
01600 ;TRANSFORM THE SOLUTION IN AC-10.
01700 FOR @' I←1,7{
01800 SYMT'I:
01900 LAC 11,[POINT 6,10,5]
02000 ILDB 3,11↔LAC 3,T'I(3)
02100 ILDB 4,11↔LAC 4,T'I(4)
02200 ILDB 5,11↔LAC 5,T'I(5)
02300 ILDB 6,11↔LAC 6,T'I(6)
02400 ILDB 7,11↔LAC 7,T'I(7)
02500 GO SYM3}
02600
02700 ;GET THE TRANSFORMED SOLUTION INTO CANONICAL FORM.
02800 SYM3: CAML 3,4↔EXCH 3,4↔CAML 3,5↔EXCH 3,5
02900 CAML 3,6↔EXCH 3,6↔CAML 3,7↔EXCH 3,7
03000 CAML 4,5↔EXCH 4,5
03100 CAML 4,6↔EXCH 4,6↔CAML 4,7↔EXCH 4,7
03200 CAML 5,6↔EXCH 5,6↔CAML 5,7↔EXCH 5,7
03300 CAML 6,7↔EXCH 6,7
03400
03500 LSH 3,6↔IOR 3,4↔LSH 3,6↔IOR 3,5
03600 LSH 3,6↔IOR 3,6↔LSH 3,6↔IOR 3,7
03700
03800 ;SEARCH BACK THROUGH THE BUFFER FOR A MATCH.
03900 LAC 4,CNT↔LAC 5,SUBTOTAL
04000 CAMN 3,BUFFER(5)↔GO M3↔SOS 5
04100 SOJG 4,.-3↔GO(12)
00100 ;MAIN EXECUTION.
00200 SA: JSR MKQAT
00300 JSR MKQQAT
00400 SETZM TOTAL#
00500
00600 DEFINE CALLQ $(Q){
00700 LACI K,Q↔JSR MK3QAT↔JSR MK5QAT
00800 DAC CNT,CNT$Q#↔ADDM CNT,TOTAL
00900 JSR OUTNUM}
01000
01100 CALLQ(23)
01200 CALLQ(22)
01300 CALLQ(13)
01400 CALLQ(12)
01500 CALLQ(11)
01600 CALLQ(03)
01700 CALLQ(02)
01800 CALLQ(01)
01900 CALLQ(00)
02000
02100 ;OUTPUT FILE OF SOLUTIONS.
02200 LAC SUBTOTAL↔DAC BUFFER
02300 INIT 1,17↔SIXBIT/DSK/↔0↔HALT
02400 ENTER 1,[SIXBIT/QFILE/↔0↔0↔0]↔JFCL
02500 OUT 1,[IOWD 5000,BUFFER↔0]↔JFCL↔RELEASE 1,
02600 CALLI 12
02700
02800 OUTNUM: 0
02900 OUTSTR[BYTE(7)15,12]↔LACI 17,PDL
03000 LAC 1,CNT↔PUSHJ 17,ONUM↔OUTCHR[9]
03100 LAC 1,SUBTOTAL↔PUSHJ 17,ONUM↔OUTCHR[9]
03200 LAC 1,TOTAL↔PUSHJ 17,ONUM
03300 GO @OUTNUM
03400
03500 END SA